home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / auctex / multi-prompt.el.z / multi-prompt.el
Encoding:
Text File  |  1998-05-21  |  4.5 KB  |  139 lines
  1. ;;; multi-prompt.el --- completing read of multiple strings.
  2.  
  3. ;; Copyright (C) 1996, 1997 Per Abrahamsen.
  4.  
  5. ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
  6. ;; Keywords: extensions
  7. ;; Version: 0.2
  8. ;; Bogus-Bureaucratic-Cruft: How 'bout ESR and the LCD people agreed
  9. ;;     on a common format?
  10.  
  11. ;; LCD Archive Entry:
  12. ;; multi-prompt|Per Abrahamsen|abraham@dina.kvl.dk|
  13. ;; completing read of multiple strings|
  14. ;; 1996-08-31|0.1|~/functions/multi-prompt.el.Z|
  15.  
  16. ;; This program is free software; you can redistribute it and/or modify
  17. ;; it under the terms of the GNU General Public License as published by
  18. ;; the Free Software Foundation; either version 2, or (at your option)
  19. ;; any later version.
  20. ;; 
  21. ;; This program is distributed in the hope that it will be useful,
  22. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24. ;; GNU General Public License for more details.
  25. ;; 
  26. ;; You should have received a copy of the GNU General Public License
  27. ;; along with this program; if not, write to the Free Software
  28. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  29.  
  30. ;;; Commentary:
  31.  
  32. ;; This package is written for use in emacs lisp programs, where the
  33. ;; user is prompted for a string of the form:
  34. ;;
  35. ;;   FOO,BAR,BAZ
  36. ;;
  37. ;; where FOO, BAR, and BAZ are elements of some table.  The function
  38. ;; `multi-prompt' is a replacement `completing-read' that will allow
  39. ;; the user to enter a string like the above, yet get completion on
  40. ;; both FOO, BAR, and BAZ.
  41.  
  42. ;;; Change Log:
  43. ;;
  44. ;; Sat Feb 15 17:58:31 MET 1997
  45. ;;      * Version 0.2 released.
  46. ;;        Renamed predicate to `mp-predicate'.
  47. ;; Sat Aug 31 18:32:20 MET DST 1996
  48. ;;      * Version 0.1 released.
  49. ;;        Fixed `predicate' bug.  
  50. ;;        Added provide.
  51. ;;        Added `multi-prompt-found' variable.
  52. ;; Sat Aug 31 16:29:14 MET DST 1996
  53. ;;      * Created.
  54.  
  55. ;;; Code:
  56.  
  57. (provide 'multi-prompt)
  58.  
  59. (defvar multi-prompt-found nil
  60.   "List of entries currently added during a `multi-prompt'.")
  61.  
  62. (defun multi-prompt (separator
  63.              unique prompt table
  64.              &optional mp-predicate require-match initial history)
  65.   "Completing prompt for a list of strings.  
  66. The first argument SEPARATOR should be the string (of length 1) to
  67. separate the elements in the list.  The second argument UNIQUE should
  68. be non-nil, if each element must be unique.  The remaining elements
  69. are the arguments to `completing-read'.  See that."
  70.   (let ((old-map (if require-match
  71.              minibuffer-local-must-match-map
  72.            minibuffer-local-completion-map))
  73.     (new-map (make-sparse-keymap)))
  74.     (if (fboundp 'set-keymap-parent)
  75.     ;; `set-keymap-parent' was introduced in Emacs 19.32.
  76.     (set-keymap-parent new-map old-map)
  77.       (setq new-map (copy-keymap old-map)))
  78.     (define-key new-map separator (if require-match
  79.                       'multi-prompt-next-must-match
  80.                     'multi-prompt-next))
  81.     (define-key new-map "\C-?" 'multi-prompt-delete)
  82.     (let* ((minibuffer-local-completion-map new-map)
  83.        (minibuffer-local-must-match-map new-map)
  84.        (multi-prompt-found nil)
  85.        (done nil)
  86.        (filter (cond (unique
  87.               (lambda (x)
  88.                 (and (not (member (car x) multi-prompt-found))
  89.                  (or (null mp-predicate)
  90.                      (funcall mp-predicate x)))))
  91.              (mp-predicate)))
  92.        (answer (catch 'multi-prompt-exit
  93.              (while t
  94.                (let ((extra (catch 'multi-prompt-next
  95.                       (throw 'multi-prompt-exit
  96.                          (completing-read prompt 
  97.                                   table
  98.                                   filter
  99.                                   require-match
  100.                                   initial
  101.                                   history)))))
  102.              (cond ((eq extra 'back)
  103.                 (when multi-prompt-found
  104.                   (setq prompt (substring 
  105.                         prompt 0 
  106.                         (- 0 (length separator)
  107.                            (length
  108.                             (car multi-prompt-found))))
  109.                     initial (car multi-prompt-found))
  110.                   (setq multi-prompt-found 
  111.                     (cdr multi-prompt-found))))
  112.                    (t
  113.                 (setq prompt (concat prompt extra separator)
  114.                       initial nil)
  115.                 (setq multi-prompt-found
  116.                       (cons extra multi-prompt-found)))))))))
  117.       (if answer 
  118.       (nreverse (cons answer multi-prompt-found))
  119.     multi-prompt-found))))
  120.  
  121. (defun multi-prompt-delete ()
  122.   (interactive)
  123.   (if (bobp)
  124.       (throw 'multi-prompt-next 'back)
  125.     (call-interactively 'backward-delete-char)))
  126.  
  127. (defun multi-prompt-next ()
  128.   (interactive)
  129.   (throw 'multi-prompt-next
  130.      (buffer-substring-no-properties (point-min) (point-max))))
  131.  
  132. (defun multi-prompt-next-must-match ()
  133.   (interactive)
  134.   (if (call-interactively 'minibuffer-complete)
  135.       (throw 'multi-prompt-next
  136.          (buffer-substring-no-properties (point-min) (point-max)))))
  137.  
  138. ;;; multi-prompt.el ends here
  139.